home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Dr. Windows 3
/
dr win3.zip
/
dr win3
/
PROGRAMR
/
WPJV1N2.ZIP
/
D&DCLIE.PAS
next >
Wrap
Pascal/Delphi Source File
|
1993-01-31
|
3KB
|
112 lines
(*****************************************)
(* *)
(* D&D-Client (d&dclie.pas) *)
(* *)
(* A simple D&D-Client *)
(* *)
(* Copyright (c) 1992,93 by A. Furrer *)
(* *)
(* This program requires Windows 3.1 *)
(*****************************************)
program DDClie;
uses Strings, WinTypes, WinProcs, WObjects, WinCRT;
(****************************************)
(* Declarations for Drag&Drop-functions *)
(****************************************)
const
wm_DropFiles = $0233;
function DragQueryFile(Drop: THandle;FileIndex: Word;
FileName: PChar;MaxChars: Word):Word; external 'SHELL'
index 11;
function DragQueryPoint(Drop: THandle;var Pt: TPoint):Bool; external 'SHELL'
index 13;
procedure DragFinish(Drop: THandle); external 'SHELL'
index 12;
procedure DragAcceptFiles(Wnd: HWnd;Accept: Bool); external 'SHELL'
index 9;
(****************)
(* Mainwindow *)
(****************)
type
PMainwindow = ^TMainwindow;
TMainwindow =object(TWindow)
procedure SetupWindow; virtual;
function CanClose: Boolean; virtual;
procedure WMDropFiles(var Msg : TMessage); virtual wm_first + wm_DropFiles;
end;
procedure TMainwindow.SetupWindow;
begin
TWindow.SetupWindow;
DragAcceptFiles(HWindow,true);
end;
function TMainwindow.CanClose;
begin
if TWindow.CanClose then
DragAcceptFiles(HWindow,false);
CanClose:=true;
end;
procedure TMainwindow.WMDropFiles;
var s : array[0..255] OF char;
i,number : word;
P : TPoint;
pc : PChar;
begin
DragQueryPoint(Msg.wParam,P);
writeln('Drop point: X:',P.X,' Y:',P.Y);
(* This is a way to detect if the drop *)
(* was in the client area or not. *)
(* It is NOT documented *)
pc:=GlobalLock(Msg.wParam);
writeln('Drop in NonClient: ',bool((pc+6)^));
GlobalUnLock(Msg.wParam);
number:=DragQueryFile(Msg.wParam,$ffff,nil,0);
writeln('Files:');
for i:=0 TO number-1 DO begin
DragQueryFile(Msg.wParam,i,s,SizeOf(s));
writeln(' ',s);
end;
DragFinish(Msg.wParam);
end;
(**********************)
(* TDDClieApplication *)
(**********************)
type
TDDClieApplication =
object(TApplication)
procedure InitMainWindow; virtual;
end;
procedure TDDClieApplication.InitMainWindow;
begin
MainWindow := New(PMainwindow,Init(nil, 'D&DClient'));
end;
(***************)
(* Mainprogram *)
(***************)
var
Prg : TDDClieApplication;
begin
Prg.Init('D&DClient');
Prg.Run;
Prg.Done;
end.